home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / TECHNICA / AUTOCAD / H108.ZIP / ZERO.ZIP / ZERO.LSP
Text File  |  1982-03-12  |  12KB  |  305 lines
  1. ;* ZERO.LSP IS A PROGRAM TO ZERO THE
  2. ;* Z COORDINATES OF ALL ENTITIES IN
  3. ;* THE DRAWING.
  4. ;*
  5. ;* WRITTEN BY P. REBBECHI 12 JULY 1991
  6. ;* COPYRIGHT CMPS&F VIC
  7. ;*
  8. ;* DXF takes an integer dxf code and an entity data list.
  9. ;* It returns the data element of the association pair.
  10. ;*
  11. (defun dxf(code elist)
  12.   (cdr (assoc code elist))   ;finds the association pair, strips 1st element
  13. )
  14. ; circ0.LSP
  15. ; Change z coord to zero
  16. ;
  17. (defun circ0 (/ g n lg e os ns el nl)
  18. (princ "\nChanging CIRCLES: ")
  19. (setq g (ssget "P"))                               ; get entities
  20.   (if g (progn                                 ; check if any
  21.       (setq n 0 lg (sslength g))                 ; set counter & No of entities
  22.       (while (< n lg)
  23.         (if (= "CIRCLE"                          ; check entity type
  24.             (cdr (assoc 0 (setq e (entget (ssname g n))))))
  25.           (progn                               ; if OK update
  26.             (setq os (assoc 10 e))             ; get current ctr pt
  27.                         (setq ns (list(car os)(cadr os)(caddr os) 0.0))
  28.             (setq e (subst ns os e)) ; swap
  29.             (setq el (assoc 38 e))             ; get current elev
  30.                         (setq nl (cons 38 0.0))
  31.             (setq e (subst nl el e)) ; swap
  32.               (entmod e)                         ; update entity
  33.           )
  34.         )
  35.       (setq n (1+ n))                      ; get next entity
  36.       )
  37.   ))
  38. )
  39. ; line0.LSP
  40. ; Change z coord to zero
  41. ;
  42. (defun line0 (/ g n lg e os ns of nf el nl)
  43. (princ "\nChanging LINES: ")
  44. (setq g (ssget "P"))                               ; get entities
  45.   (if g (progn                                 ; check if any
  46.       (setq n 0 lg (sslength g))                 ; set counter & No of entities
  47.       (while (< n lg)
  48.         (if (= "LINE"                          ; check entity type
  49.             (cdr (assoc 0 (setq e (entget (ssname g n))))))
  50.           (progn                               ; if OK update
  51.             (setq os (assoc 10 e))             ; get current start pt
  52.                         (setq ns (list(car os)(cadr os)(caddr os) 0.0))
  53.             (setq e (subst ns os e)) ; swap
  54.             (setq of (assoc 11 e))             ; get current end pt
  55.                         (setq nf (list(car of)(cadr of)(caddr of) 0.0))
  56.             (setq e (subst nf of e)) ; swap
  57.             (setq el (assoc 38 e))             ; get current elev
  58.                         (setq nl (cons 38 0.0))
  59.             (setq e (subst nl el e)) ; swap
  60.               (entmod e)                         ; update entity
  61.           )
  62.         )
  63.       (setq n (1+ n))                      ; get next entity
  64.       )
  65.   ))
  66. )
  67. ; arc0.LSP
  68. ; Change z coord to zero
  69. ;
  70. (defun arc0 (/ g n lg e os ns el nl)
  71. (princ "\nChanging ARCS: ")
  72. (setq g (ssget "P"))                               ; get entities
  73.   (if g (progn                                 ; check if any
  74.       (setq n 0 lg (sslength g))                 ; set counter & No of entities
  75.       (while (< n lg)
  76.         (if (= "ARC"                          ; check entity type
  77.             (cdr (assoc 0 (setq e (entget (ssname g n))))))
  78.           (progn                               ; if OK update
  79.             (setq os (assoc 10 e))             ; get current ctr pt
  80.                         (setq ns (list(car os)(cadr os)(caddr os) 0.0))
  81.             (setq e (subst ns os e)) ; swap
  82.             (setq el (assoc 38 e))             ; get current elev
  83.                         (setq nl (cons 38 0.0))
  84.             (setq e (subst nl el e)) ; swap
  85.               (entmod e)                         ; update entity
  86.           )
  87.         )
  88.       (setq n (1+ n))                      ; get next entity
  89.       )
  90.   ))
  91. )    
  92. ; sol0.LSP
  93. ; Change z coord to zero
  94. ;
  95. (defun sol0 (/ g n lg e o1 n1 o2 n2 o3 n3 o4 n4 el nl)
  96. (princ "\nChanging SOLIDS:" )
  97. (setq g (ssget "P"))                               ; get entities
  98.   (if g (progn                                 ; check if any
  99.       (setq n 0 lg (sslength g))                 ; set counter & No of entities
  100.       (while (< n lg)
  101.         (if (= "SOLID"                          ; check entity type
  102.             (cdr (assoc 0 (setq e (entget (ssname g n))))))
  103.           (progn                               ; if OK update
  104.           (setq o1 (assoc 10 e))             ; get current first pt
  105.                         (setq n1 (list(car o1)(cadr o1)(caddr o1) 0.0))
  106.             (setq e (subst n1 o1 e)) ; swap
  107.              (setq o2 (assoc 11 e))             ; get current second pt
  108.                         (setq n2 (list(car o2)(cadr o2)(caddr o2) 0.0))
  109.             (setq e (subst n2 o2 e)) ; swap
  110.             (setq o3 (assoc 12 e))             ; get current third pt
  111.                         (setq n3 (list(car o3)(cadr o3)(caddr o3) 0.0))
  112.             (setq e (subst n3 o3 e)) ; swap
  113.             (setq o4 (assoc 13 e))             ; get current fourth pt
  114.                         (setq n4 (list(car o4)(cadr o4)(caddr o4) 0.0))
  115.             (setq e (subst n4 o4 e)) ; swap
  116.             (setq el (assoc 38 e))             ; get current elev
  117.                         (setq nl (cons 38 0.0))
  118.             (setq e (subst nl el e)) ; swap
  119.               (entmod e)                         ; update entity
  120.           )
  121.         )
  122.       (setq n (1+ n))                      ; get next entity
  123.       )
  124.   ))
  125. )
  126. ; text0.LSP
  127. ; Change z coord to zero
  128. ;
  129. (defun text0 (/ g n lg e os ns of nf el nl)
  130. (princ "\nChanging TEXT: ")
  131. (setq g (ssget "P"))                               ; get entities
  132.   (if g (progn                                 ; check if any
  133.       (setq n 0 lg (sslength g))                 ; set counter & No of entities
  134.       (while (< n lg)
  135.         (if (= "TEXT"                          ; check entity type
  136.             (cdr (assoc 0 (setq e (entget (ssname g n))))))
  137.           (progn                               ; if OK update
  138.             (setq os (assoc 10 e))             ; get current start pt
  139.                         (setq ns (list(car os)(cadr os)(caddr os) 0.0))
  140.             (setq e (subst ns os e)) ; swap
  141.             (setq of (assoc 11 e))             ; get current align pt
  142.                         (setq nf (list(car of)(cadr of)(caddr of) 0.0))
  143.             (setq e (subst nf of e)) ; swap
  144.             (setq el (assoc 38 e))             ; get current elev
  145.                         (setq nl (cons 38 0.0))
  146.             (setq e (subst nl el e)) ; swap
  147.               (entmod e)                         ; update entity
  148.           )
  149.         )
  150.       (setq n (1+ n))                      ; get next entity
  151.       )
  152.   ))
  153. )
  154. ; pt0.LSP
  155. ; Change z coord to zero
  156. ;
  157. (defun pt0 (/ g n lg e os el nl)
  158. (princ "\nChanging POINTS: ")
  159. (setq g (ssget "P"))                               ; get entities
  160.   (if g (progn                                 ; check if any
  161.       (setq n 0 lg (sslength g))                 ; set counter & No of entities
  162.       (while (< n lg)
  163.         (if (= "POINT"                          ; check entity type
  164.             (cdr (assoc 0 (setq e (entget (ssname g n))))))
  165.           (progn                               ; if OK update
  166.             (setq os (assoc 10 e))             ; get current start pt
  167.                         (setq ns (list(car os)(cadr os)(caddr os) 0.0))
  168.             (setq e (subst ns os e)) ; swap
  169.             (setq el (assoc 38 e))             ; get current elev
  170.                         (setq nl (cons 38 0.0))
  171.             (setq e (subst nl el e)) ; swap
  172.               (entmod e)                         ; update entity
  173.           )
  174.         )
  175.       (setq n (1+ n))                      ; get next entity
  176.       )
  177.   ))
  178. )
  179. ; dim0.LSP
  180. ; Change z coord to zero
  181. ;
  182. (defun dim0 (/ g n lg e o1 n1 o2 n2 o3 n3 o4 n4 o5 n5 o6 n6 o7 n7 el nl)
  183. (princ "\nChanging DIMS: ")
  184. (setq g (ssget "P"))                               ; get entities
  185.   (if g (progn                                 ; check if any
  186.       (setq n 0 lg (sslength g))                 ; set counter & No of entities
  187.       (while (< n lg)
  188.         (if (= "DIMENSION"                          ; check entity type
  189.             (cdr (assoc 0 (setq e (entget (ssname g n))))))
  190.           (progn                               ; if OK update
  191.           (setq o1 (assoc 10 e))             ; get current first pt
  192.                         (setq n1 (list(car o1)(cadr o1)(caddr o1) 0.0))
  193.             (setq e (subst n1 o1 e)) ; swap
  194.              (setq o2 (assoc 11 e))             ; get current second pt
  195.                         (setq n2 (list(car o2)(cadr o2)(caddr o2) 0.0))
  196.             (setq e (subst n2 o2 e)) ; swap
  197.             (setq o3 (assoc 12 e))             ; get current third pt
  198.                         (setq n3 (list(car o3)(cadr o3)(caddr o3) 0.0))
  199.             (setq e (subst n3 o3 e)) ; swap
  200.             (setq o4 (assoc 13 e))             ; get current fourth pt
  201.                         (setq n4 (list(car o4)(cadr o4)(caddr o4) 0.0))
  202.             (setq e (subst n4 o4 e)) ; swap
  203.          (setq o5 (assoc 14 e))             ; get current fifth pt
  204.                         (setq n5 (list(car o5)(cadr o5)(caddr o5) 0.0))
  205.             (setq e (subst n5 o5 e)) ; swap
  206.             (setq o6 (assoc 15 e))             ; get current sixth pt
  207.                         (setq n6 (list(car o6)(cadr o6)(caddr o6) 0.0))
  208.             (setq e (subst n6 o6 e)) ; swap
  209.             (setq o7 (assoc 16 e))             ; get current seventh pt
  210.                         (setq n7 (list(car o7)(cadr o7)(caddr o7) 0.0))
  211.             (setq e (subst n7 o7 e)) ; swap
  212.             (setq el (assoc 38 e))             ; get current elev
  213.                         (setq nl (cons 38 0.0))
  214.             (setq e (subst nl el e)) ; swap
  215.             (entmod e)                         ; update entity
  216.           )
  217.         )
  218.       (setq n (1+ n))                      ; get next entity
  219.       )
  220.   ))
  221. )
  222. ; pline0.LSP
  223. ; Change z coord to zero
  224. ;
  225. (defun pline0 (/ g n lg e os ns el nl ed en)
  226. (princ "\nChanging PLINES and DONUTS: ")
  227. (setq g (ssget "P"))                               ; get entities
  228.   (if g (progn                                 ; check if any
  229.       (setq n 0 lg (sslength g))                 ; set counter & No of entities
  230.       (while (< n lg)
  231.         (if (= "POLYLINE"                          ; check entity type
  232.             (cdr (assoc 0 (setq e (entget (ssname g n))))))
  233.           (progn                               ; if OK update
  234.             (setq os (assoc 10 e))             ; get current start pt
  235.                         (setq ns (list(car os)(cadr os)(caddr os) 0.0))
  236.             (setq e (subst ns os e)) ; swap
  237.             (setq el (assoc 38 e))             ; get current elev
  238.                         (setq nl (cons 38 0.0))
  239.             (setq e (subst nl el e)) ; swap
  240.               (entmod e)                         ; modify entity
  241.           ;
  242.                     ; SUBENTS 
  243.                     (SETQ en (DXF -1 e))                            ;get first subentity - vertex
  244.                     (while (and (setq en (entnext en));loop thu each vertex
  245.                     (SETQ ED (ENTGET EN));get vertex data
  246.                     (/= "SEQEND" (dxf 0 ed)); if seqend finish
  247.                     );and
  248.                     (progn
  249.                     (setq os (assoc 10 ed))             ; get current vertex pt
  250.                     (setq ns (list(car os)(cadr os)(caddr os) 0.0));build new pt
  251.           (setq ed (subst ns os ed)) ; swap
  252.           (setq el (assoc 38 e))             ; get current elev
  253.                         (setq nl (cons 38 0.0))
  254.             (setq e (subst nl el e)) ; swap
  255.             (entmod ed);modify the vertex
  256.                     );progn
  257.                     );while 
  258.         (entupd en)
  259.                     )
  260.                 );if
  261.       (setq n (1+ n))                      ; get next entity
  262.       )
  263.   ))
  264. )
  265. ; ins0.LSP
  266. ; Change z coord to zero
  267. ;
  268. (defun ins0 (/ g n lg e os ns el nl)
  269. (princ "\nChanging BLOCK INSERTS: ")
  270. (setq g (ssget "P"))                               ; get entities
  271.   (if g (progn                                 ; check if any
  272.       (setq n 0 lg (sslength g))                 ; set counter & No of entities
  273.       (while (< n lg)
  274.         (if (= "INSERT"                          ; check entity type
  275.             (cdr (assoc 0 (setq e (entget (ssname g n))))))
  276.           (progn                               ; if OK update
  277.             (setq os (assoc 10 e))             ; get current ctr pt
  278.                         (setq ns (list(car os)(cadr os)(caddr os) 0.0))
  279.             (setq e (subst ns os e)) ; swap
  280.             (setq el (assoc 38 e))             ; get current elev
  281.                         (setq nl (cons 38 0.0))
  282.             (setq e (subst nl el e)) ; swap
  283.               (entmod e)                         ; update entity
  284.           )
  285.         )
  286.       (setq n (1+ n))                      ; get next entity
  287.       )
  288.   ))
  289. )
  290. ;
  291. (defun c:zero ()
  292. (setq g (ssget))                               ; get entities
  293. (circ0)
  294. (line0)
  295. (arc0)
  296. (sol0)
  297. (text0)
  298. (pt0)
  299. (dim0)
  300. (pline0)
  301. (ins0)
  302. (princ)
  303. )
  304.  
  305.